unit HashTable;

{ from Delphi IniFiles.TStringHash }

interface

uses SysUtils, Classes;

type
  PPHashItem = ^PHashItem;
  PHashItem = ^THashItem;
  THashItem = record
    Next: PHashItem;
    Key: string;
    Value: string;
  end;

  THashTable = class
  private
    Buckets: array of PHashItem;
    function Get(const Key: string): string;
    procedure Put(const Key: string; Value: string);
  protected
    function Find(const Key: string): PPHashItem;
    function HashOf(const Key: string): Cardinal; virtual;
  public
    constructor Create(Size: Integer = 512);
    destructor Destroy; override;
    procedure Clear;
    procedure Remove(const Key: string);
    function Modify(const Key: string; Value: string): Boolean;
    procedure GetBucketsInfo(var FillCount, MaxDepth: Integer);
    property ValueOf[const Key: string]: string read Get write Put; default;
  end;

implementation

type
  uint8 = Byte;
  int32 = Integer;
  uint16 = Word;
  uint32 = Cardinal;

  PUInt8 = ^uint8;
  PUInt32 = ^uint32;
  UInt8_p = ^uint8_array;
  uint8_array = array [0..MaxInt - 1] of uint8;

// from sWZ_HashLib.pas
function SuperFastHash(lpMem: PByte; nSize: uint32): uint32;
var
  nRem, nLen: uint32;
  nHash, nTemp: UInt32;
begin
  Result := 0;
  //if ((lpMem = nil) or (nSize = 0)) then Exit;
  //if (Not sWZ_IsReadPtr(lpMem, nSize)) then Exit;

  nHash := nSize;
  nRem := nSize and 3;
  nLen := nSize shr 2;

  //  Main loop
  while (nLen > 0) do
  begin
    nHash := nHash + ((UInt8_p(lpMem)[1] shl 8) + UInt8_p(lpMem)[0]);
    nTemp := (((UInt8_p(lpMem)[3] shl 8) + UInt8_p(lpMem)[2]) shl 11) xor nHash;
    nHash := (nHash shl 16) xor nTemp;
    Inc(PUInt8(lpMem), (2 * SizeOf(UInt16)));
    nHash := nHash + (nHash shr 11);

    Dec(nLen);
  end;

  //  Handle end cases
  case (nRem) of
    3:
    begin
      nHash := nHash + ((UInt8_p(lpMem)[1] shl 8) + UInt8_p(lpMem)[0]);
      nHash := nHash xor (nHash shl 16);
      nHash := nHash xor (UInt8_p(lpMem)[SizeOf(Uint16)] shl 18);
      nHash := nHash + (nHash shr 11);
    end;

    2:
    begin
      nHash := nHash + ((UInt8_p(lpMem)[1] shl 8) + UInt8_p(lpMem)[0]);
      nHash := nHash xor (nHash shl 11);
      nHash := nHash + (nHash shr 17);
    end;

    1:
    begin
      nHash := nHash + PUInt8(lpMem)^;
      nHash := nHash xor (nHash shl 10);
      nHash := nHash + (nHash shr 1);
    end;

    0:;
  else
    Exit;
  end;

  //  Force "avalanching" of final 127 bits
  nHash := nHash xor (nHash shl 3);
  nHash := nHash + (nHash shr 5);
  nHash := nHash xor (nHash shl 4);
  nHash := nHash + (nHash shr 17);
  nHash := nHash xor (nHash shl 25);
  nHash := nHash + (nHash shr 6);
  Result := nHash;
end;

 { THashTable }

constructor THashTable.Create(Size: Integer);
begin
  inherited Create;
  SetLength(Buckets, Size);
end;

destructor THashTable.Destroy;
begin
  Clear;
  inherited;
end;

function THashTable.Get(const Key: string): string;
var
  P: PHashItem;
begin
  P := Find(Key)^;
  if P <> nil then
    Result := P^.Value else
    Result := '';
end;

procedure THashTable.GetBucketsInfo(var FillCount, MaxDepth: Integer);
var
  i: Integer;
  P: PHashItem;
  depth: Integer;
begin
  FillCount := 0;
  MaxDepth  := 0;
  for i := Low(Buckets) to High(Buckets) do begin
    P := Buckets[i];
    if Assigned(P) then begin
      Inc(FillCount);
      depth := 0;
      repeat
        Inc(depth);
        P := P.Next;
      until P = nil;
      if depth > MaxDepth then
        MaxDepth := depth;
    end;
  end;
end;

procedure THashTable.Put(const Key: string; Value: string);
var
  Hash: Integer;
  Bucket: PHashItem;
begin
  Hash := HashOf(Key) mod Cardinal(Length(Buckets));
  New(Bucket);
  Bucket^.Key := Key;
  Bucket^.Value := Value;
  Bucket^.Next := Buckets[Hash];
  Buckets[Hash] := Bucket;
end;

function THashTable.Find(const Key: string): PPHashItem;
var
  Hash: Integer;
begin
  Hash := HashOf(Key) mod Cardinal(Length(Buckets));
  Result := @Buckets[Hash];
  while Result^ <> nil do
  begin
    if Result^.Key = Key then
      Exit
    else
      Result := @Result^.Next;
  end;
end;

{
Test Result:    [FillCount, MaxDepth]

Bucket Size   DelphiHash   SuperFastHash
256           135, 9       143, 4
512           154, 7       168, 4
1024          161, 6       182, 3
2048          173, 4       191, 3
4096          187, 3       194, 3
}
function THashTable.HashOf(const Key: string): Cardinal;
//var
//  I: Integer;
begin
  Result := SuperFastHash(PByte(PChar(Key)), Length(Key)*SizeOf(Char));
//  for I := 1 to Length(Key) do
//    Result := ((Result shl 2) or (Result shr (SizeOf(Result) * 8 - 2))) xor
//      Ord(Key[I]);
end;

procedure THashTable.Clear;
var
  I: Integer;
  P, N: PHashItem;
begin
  for I := 0 to Length(Buckets) - 1 do
  begin
    P := Buckets[I];
    while P <> nil do
    begin
      N := P^.Next;
      Dispose(P);
      P := N;
    end;
    Buckets[I] := nil;
  end;
end;

procedure THashTable.Remove(const Key: string);
var
  P: PHashItem;
  Prev: PPHashItem;
begin
  Prev := Find(Key);
  P := Prev^;
  if P <> nil then
  begin
    Prev^ := P^.Next;
    Dispose(P);
  end;
end;

function THashTable.Modify(const Key: string; Value: string): Boolean;
var
  P: PHashItem;
begin
  P := Find(Key)^;
  if P <> nil then
  begin
    Result := True;
    P^.Value := Value;
  end
  else
    Result := False;
end;

end.

